home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE12 / CONSTRUC / FIRST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-07-17  |  2.5 KB  |  107 lines
  1. unit first;
  2. {$I+ will raise IO-exceptions when needed }
  3. interface
  4. uses
  5.   WinTypes, WinProcs, SysUtils, Classes;
  6.  
  7. Const
  8.   BlockLine = 16;
  9.   BlockChar = 16;
  10.   BlockSize = BlockLine * BlockChar; { 16 x 16 = 256 }
  11.  
  12. Type
  13.   TBlock = Array[1..BlockSize] of Byte;
  14.  
  15.   TBFile = class(TComponent)
  16.     private
  17.       { Private declarations }
  18.       FFileName: TFileName;
  19.       FFile: File;
  20.       FOffset: LongInt; { 0, 256, 512, ... }
  21.       FBlock: TBlock; { data from FFile }
  22.       FSize: Cardinal; { actual size of data in FBlock <= BlockSize }
  23.  
  24.     protected
  25.       { Protected declarations }
  26.       procedure SetFileName(AFileName: TFileName); virtual;
  27.       procedure SetOffset(AnOffset: LongInt); virtual;
  28.  
  29.     public
  30.       { Public declarations }
  31.       constructor Create(AOwner: TComponent); override;
  32.       destructor Destroy; override;
  33.  
  34.     published
  35.       { Published declarations }
  36.       property FileName: TFileName read FFileName write SetFileName;
  37.       property Offset: LongInt read FOffset write SetOffset default 0;
  38.     end {TBFile};
  39.  
  40.   procedure Register;
  41.  
  42. implementation
  43.  
  44.   constructor TBFile.Create(AOwner: TComponent);
  45.   var i: Integer;
  46.   begin
  47.     inherited Create(AOwner);
  48.     FFileName := '';
  49.     FOffset := 0;
  50.     FSize := 0
  51.   end {Create};
  52.  
  53.   destructor TBFile.Destroy;
  54.   begin
  55.     if FFileName <> '' then Close(FFile);
  56.     inherited Destroy
  57.   end {Destroy};
  58.  
  59.   procedure TBFile.SetFileName(AFileName: TFileName);
  60.   begin
  61.     if FFileName <> '' then
  62.     begin
  63.       FFileName := '';
  64.       FOffset := 0;
  65.       FSize := 0;
  66.       System.Close(FFile)
  67.     end;
  68.     System.Assign(FFile,AFileName);
  69.     try
  70.       FileMode := $42; { read/write, deny-none }
  71.       System.Reset(FFile,1);
  72.       FFileName := AFileName { success! }
  73.     except
  74.       FFileName := ''
  75.     end;
  76.     Offset := 0
  77.   end {SetFileName};
  78.  
  79.   procedure TBFile.SetOffset(AnOffset: LongInt);
  80.   begin
  81.     AnOffset := AnOffset AND NOT BlockLine; { skip lower bits }
  82.     if (AnOffset <> FOffset) or (AnOffset = 0) or (FOffset = 0) then
  83.     begin
  84.       FOffset := AnOffset;
  85.       FillChar(FBlock,SizeOf(FBlock),#0);
  86.       if FFileName <> '' then
  87.       try
  88.         Seek(FFile,FOffset);
  89.         BlockRead(FFile,FBlock,SizeOf(FBlock),FSize);
  90.       except
  91.         FOffset := 0;
  92.         FSize := 0
  93.       end
  94.       else
  95.       begin
  96.         FOffset := 0;
  97.         FSize := 0
  98.       end
  99.     end
  100.   end {SetOffset};
  101.  
  102.   procedure Register;
  103.   begin
  104.     RegisterComponents('Dr.Bob',[TBFile])
  105.   end;
  106. end.
  107.